home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / maze.arc / EMAZE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-12-31  |  15.5 KB  |  407 lines
  1. PROGRAM mazes;
  2.   {
  3.          This IBM PC program will produce a series of mazes on
  4.     an EPSON MX-80 printer.  A different random number seed will
  5.     produce a different series of mazes.
  6.   
  7.          Written by James L. Dean
  8.                     406 40th Street
  9.                     New Orleans, LA 70124
  10.   }
  11.   CONST
  12.     num_columns = 95; 
  13.     x_max = 190;      {2*num_columns}
  14.     num_rows = 120;
  15.     y_max = 240;      {2*num_rows}
  16.   TYPE
  17.     stack_rec_ptr = ^stack_rec;
  18.     stack_rec = RECORD
  19.                   index_1 : BYTE;
  20.                   index_2 : BYTE;
  21.                   next_ptr : stack_rec_ptr
  22.                 END;
  23.   VAR
  24.     column                     : INTEGER;
  25.     column_mod_5               : INTEGER;
  26.     counter_0                  : INTEGER;
  27.     counter_1                  : INTEGER;
  28.     counter_2                  : INTEGER;
  29.     counter_3                  : INTEGER;
  30.     counter_4                  : INTEGER;
  31.     counter_5                  : INTEGER;
  32.     counter_6                  : INTEGER;
  33.     counter_7                  : INTEGER;
  34.     delta_index_1              : INTEGER;
  35.     delta_index_1a             : INTEGER;
  36.     delta_index_1b             : INTEGER;
  37.     delta_index_1c             : INTEGER;
  38.     delta_index_1d             : INTEGER;
  39.     delta_index_2              : INTEGER;
  40.     delta_x                    : ARRAY [1..4,1..24] OF INTEGER;
  41.     delta_y                    : ARRAY [1..4,1..24] OF INTEGER;
  42.     maze_num                   : INTEGER;
  43.     num_mazes                  : INTEGER;
  44.     page                       : ARRAY [0..y_max,0..x_max] OF CHAR;
  45.     passage_found              : BOOLEAN;
  46.     power_of_two               : INTEGER;
  47.     print_line                 : ARRAY[0..479] OF BYTE;
  48.     r_n                        : ARRAY [1..8] OF INTEGER;
  49.     r_n_index_1                : INTEGER;
  50.     r_n_index_2                : INTEGER;
  51.     response                   : CHAR;
  52.     row_mod_6                  : INTEGER;
  53.     seed                       : STRING[8];
  54.     stack_head                 : stack_rec_ptr;
  55.     stack_ptr                  : stack_rec_ptr;
  56.     tem_int                    : INTEGER;
  57.     tem_real                   : REAL;
  58.     x                          : INTEGER;
  59.     x_next                     : INTEGER;
  60.     x_out                      : INTEGER;
  61.     x_wall_1                   : INTEGER;
  62.     y                          : INTEGER;
  63.     y_next                     : INTEGER;
  64.     y_out                      : INTEGER;
  65.     y_wall_1                   : INTEGER;
  66.   FUNCTION uniform(VAR counter_0,counter_1,counter_2,counter_3,
  67.    counter_4,counter_5,counter_6,counter_7 : INTEGER) : REAL;
  68.     CONST
  69.       substitution_high   : ARRAY (.0..99.) OF INTEGER =(
  70.       4,1,2,8,8,9,9,6,5,7,2,1,2,9,8,8,6,3,5,1,9,5,4,4,9,8,6,0,8,0,
  71.       6,0,2,4,1,9,2,0,7,4,7,3,0,0,2,6,8,9,4,0,8,3,2,3,2,5,2,4,6,9,
  72.       7,9,1,3,5,7,1,1,4,5,8,1,6,0,5,7,8,2,3,3,7,3,5,1,7,5,4,0,3,6,
  73.       3,7,7,1,9,4,0,5,6,6);
  74.       substitution_low    : ARRAY (.0..99.) OF INTEGER =(
  75.       1,2,2,1,5,5,4,6,4,6,4,4,5,6,6,3,0,9,6,5,7,2,0,9,3,4,2,3,9,1,
  76.       9,9,9,3,8,9,3,4,1,5,0,5,2,7,0,8,8,0,4,5,0,3,6,8,1,7,8,8,7,1,
  77.       3,2,7,7,1,8,0,3,7,5,2,6,4,0,9,9,7,7,4,6,2,0,0,1,7,3,6,6,1,1,
  78.       2,4,5,9,8,2,8,8,3,5);
  79.     VAR
  80.       iteration,
  81.       seed_0,
  82.       seed_1,
  83.       seed_2,
  84.       seed_3,
  85.       seed_4,
  86.       seed_5,
  87.       seed_6,
  88.       seed_7,
  89.       substitution_index,
  90.       tem_0,
  91.       tem_1,
  92.       tem_2,
  93.       tem_3
  94.                           : INTEGER;
  95.       dividend,
  96.       tem_real
  97.                           : REAL;
  98.     BEGIN
  99.       tem_2:=counter_0+1;
  100.       IF tem_2 <= 9 THEN
  101.         counter_0:=tem_2
  102.       ELSE
  103.         BEGIN
  104.           counter_0:=0;
  105.           tem_2:=counter_1+1;
  106.           IF tem_2 <= 9 THEN
  107.             counter_1:=tem_2
  108.           ELSE
  109.             BEGIN
  110.               counter_1:=0;
  111.               tem_2:=counter_2+1;
  112.               IF tem_2 <= 9 THEN
  113.                 counter_2:=tem_2
  114.               ELSE
  115.                 BEGIN
  116.                   counter_2:=0;
  117.                   tem_2:=counter_3+1;
  118.                   IF tem_2 <= 9 THEN
  119.                     counter_3:=tem_2
  120.                   ELSE
  121.                     BEGIN
  122.                       counter_3:=0;
  123.                       tem_2:=counter_4+1;
  124.                       IF tem_2 <= 9 THEN
  125.                         counter_4:=tem_2
  126.                       ELSE
  127.                         BEGIN
  128.                           counter_4:=0;
  129.                           tem_2:=counter_5+1;
  130.                           IF tem_2 <= 9 THEN
  131.                             counter_5:=tem_2
  132.                           ELSE
  133.                             BEGIN
  134.                               counter_5:=0;
  135.                               tem_2:=counter_6+1;
  136.                               IF tem_2 <= 9 THEN
  137.                                 counter_6:=tem_2
  138.                               ELSE
  139.                                 BEGIN
  140.                                   counter_6:=0;
  141.                                   tem_2:=counter_7+1;
  142.                                   IF tem_2 <= 9 THEN
  143.                                     counter_7:=tem_2
  144.                                   ELSE
  145.                                     counter_7:=0
  146.                                 END
  147.                             END
  148.                         END
  149.                     END
  150.                 END
  151.             END
  152.         END;
  153.       seed_0:=counter_0;
  154.       seed_1:=counter_1;
  155.       seed_2:=counter_2;
  156.       seed_3:=counter_3;
  157.       seed_4:=counter_4;
  158.       seed_5:=counter_5;
  159.       seed_6:=counter_6;
  160.       seed_7:=counter_7;
  161.       FOR iteration:=1 TO 8 DO
  162.         BEGIN
  163.           substitution_index:=10*seed_1+seed_0;
  164.           tem_0:=substitution_low(.substitution_index.);
  165.           tem_1:=substitution_high(.substitution_index.);
  166.           substitution_index:=10*seed_3+seed_2;
  167.           seed_0:=substitution_low(.substitution_index.);
  168.           tem_3:=substitution_high(.substitution_index.);
  169.           substitution_index:=10*seed_5+seed_4;
  170.           seed_2:=substitution_low(.substitution_index.);
  171.           seed_1:=substitution_high(.substitution_index.);
  172.           substitution_index:=10*seed_7+seed_6;
  173.           seed_5:=substitution_low(.substitution_index.);
  174.           seed_7:=substitution_high(.substitution_index.);
  175.           seed_3:=tem_0;
  176.           seed_6:=tem_1;
  177.           seed_4:=tem_3
  178.         END;
  179.       tem_2:=1000*seed_3+100*seed_2+10*seed_1+seed_0;
  180.       tem_real:=tem_2;
  181.       tem_real:=tem_real/10000.0;
  182.       tem_2:=1000*seed_7+100*seed_6+10*seed_5+seed_4;
  183.       dividend:=tem_2;
  184.       tem_real:=(dividend+tem_real)/10000.0;
  185.       uniform:=tem_real
  186.     END;
  187.   BEGIN
  188.     ClrScr;
  189.     WRITELN(OUTPUT,'                                 Maze Generator');
  190.     WRITELN(OUTPUT,' '); WRITELN(OUTPUT,' '); WRITELN(OUTPUT,' ');
  191.     WRITE(OUTPUT,'How many mazes are to be generated?  ');
  192.     READLN(INPUT,num_mazes);
  193.     IF num_mazes >= 1 THEN
  194.       BEGIN
  195.         WRITELN(OUTPUT,' ');
  196.         WRITE(OUTPUT,'Random number seed?  ');
  197.         READLN(INPUT,seed);
  198.         WHILE (Length(seed) < 8) DO seed:=CONCAT('0',seed);
  199.         counter_0:=ORD(seed[1]) MOD 10;
  200.         counter_1:=ORD(seed[2]) MOD 10;
  201.         counter_2:=ORD(seed[3]) MOD 10;
  202.         counter_3:=ORD(seed[4]) MOD 10;
  203.         counter_4:=ORD(seed[5]) MOD 10;
  204.         counter_5:=ORD(seed[6]) MOD 10;
  205.         counter_6:=ORD(seed[7]) MOD 10;
  206.         counter_7:=ORD(seed[8]) MOD 10;
  207.         WRITELN(OUTPUT,' ');
  208.         WRITELN(OUTPUT,'Position your paper at top of form and press RETURN.');
  209.         READLN(INPUT,response);
  210.         IF num_mazes = 1 THEN
  211.           WRITELN(OUTPUT,'Generating maze...')
  212.         ELSE
  213.           WRITELN(OUTPUT,'Generating mazes...');
  214.         delta_x[1,1]:=-1;
  215.         delta_y[1,1]:=0;
  216.         delta_x[2,1]:=0;
  217.         delta_y[2,1]:=1;
  218.         delta_x[3,1]:=1;
  219.         delta_y[3,1]:=0;
  220.         delta_x[4,1]:=0;
  221.         delta_y[4,1]:=-1;
  222.         delta_index_2:=0;
  223.         FOR delta_index_1a:=1 TO 4 DO
  224.           FOR delta_index_1b:=1 TO 4 DO
  225.             IF delta_index_1a <> delta_index_1b THEN
  226.               FOR delta_index_1c:=1 TO 4 DO
  227.                 IF ((delta_index_1a <> delta_index_1c)
  228.                 AND (delta_index_1b <> delta_index_1c)) THEN
  229.                   FOR delta_index_1d:=1 TO 4 DO
  230.                     IF ((delta_index_1a <> delta_index_1d)
  231.                     AND (delta_index_1b <> delta_index_1d)
  232.                     AND (delta_index_1c <> delta_index_1d)) THEN
  233.                       BEGIN
  234.                         delta_index_2:=delta_index_2+1;
  235.                         delta_x[delta_index_1a,delta_index_2]:=delta_x[1,1];
  236.                         delta_y[delta_index_1a,delta_index_2]:=delta_y[1,1];
  237.                         delta_x[delta_index_1b,delta_index_2]:=delta_x[2,1];
  238.                         delta_y[delta_index_1b,delta_index_2]:=delta_y[2,1];
  239.                         delta_x[delta_index_1c,delta_index_2]:=delta_x[3,1];
  240.                         delta_y[delta_index_1c,delta_index_2]:=delta_y[3,1];
  241.                         delta_x[delta_index_1d,delta_index_2]:=delta_x[4,1];
  242.                         delta_y[delta_index_1d,delta_index_2]:=delta_y[4,1]
  243.                       END;
  244.         FOR maze_num:=1 TO num_mazes DO
  245.           BEGIN
  246.             seed:='';
  247.             FOR r_n_index_1:=1 TO 8 DO
  248.               BEGIN
  249.                 tem_real:=10.0*uniform(counter_0,counter_1,counter_2,counter_3,                             
  250.                  counter_4,counter_5,counter_6,counter_7);
  251.                 tem_int:=TRUNC(tem_real);
  252.                 tem_int:=tem_int+ORD('0');
  253.                 seed:=CONCAT(seed,CHR(tem_int));
  254.                 WHILE (tem_int > 29) DO tem_int:=tem_int-29;
  255.                 IF tem_int = 0 THEN tem_int:=1;
  256.                 r_n[r_n_index_1]:=tem_int
  257.               END;
  258.             FOR x_out:=0 TO x_max DO
  259.               FOR y_out:=0 TO y_max DO
  260.                 page[y_out,x_out]:='W';
  261.             IF ODD(num_columns) THEN
  262.               x:=num_columns
  263.             ELSE
  264.               x:=(num_columns-1);
  265.             IF ODD(num_rows) THEN
  266.               y:=num_rows
  267.             ELSE
  268.               y:=(num_rows-1);
  269.             page[y,x]:=' ';
  270.             stack_head:=NIL;
  271.             REPEAT
  272.               delta_index_1:=1;
  273.               REPEAT
  274.                 delta_index_2:=r_n[1];
  275.                 r_n_index_1:=1;
  276.                 FOR r_n_index_2:=2 TO 8 DO
  277.                   BEGIN
  278.                     tem_int:=r_n[r_n_index_2];
  279.                     r_n[r_n_index_1]:=tem_int;
  280.                     delta_index_2:=delta_index_2+tem_int;
  281.                     IF delta_index_2 > 29 THEN
  282.                       delta_index_2:=delta_index_2-29;
  283.                     r_n_index_1:=r_n_index_2
  284.                   END;
  285.                 r_n[8]:=delta_index_2
  286.               UNTIL
  287.                 (delta_index_2 <= 24);
  288.               passage_found:=FALSE;
  289.               REPEAT
  290.                 WHILE ((delta_index_1 <= 4) AND (NOT passage_found)) DO
  291.                   BEGIN
  292.                     x_next:=x+2*delta_x[delta_index_1,delta_index_2];
  293.                     IF x_next <= 0 THEN
  294.                       delta_index_1:=delta_index_1+1
  295.                     ELSE
  296.                       IF x_next >= x_max THEN
  297.                         delta_index_1:=delta_index_1+1
  298.                       ELSE
  299.                         BEGIN
  300.                           y_next:=y+2*delta_y[delta_index_1,delta_index_2];
  301.                           IF y_next <= 0 THEN
  302.                             delta_index_1:=delta_index_1+1
  303.                           ELSE
  304.                             IF y_next >= y_max THEN
  305.                               delta_index_1:=delta_index_1+1
  306.                             ELSE
  307.                               IF page[y_next,x_next] = 'W' THEN
  308.                                 passage_found:=TRUE
  309.                               ELSE
  310.                                 delta_index_1:=delta_index_1+1
  311.                         END
  312.                   END;
  313.                 IF (NOT passage_found) THEN
  314.                   BEGIN
  315.                     delta_index_1:=stack_head^.index_1;
  316.                     delta_index_2:=stack_head^.index_2;
  317.                     x:=x-2*delta_x[delta_index_1,delta_index_2];
  318.                     y:=y-2*delta_y[delta_index_1,delta_index_2];
  319.                     stack_ptr:=stack_head;
  320.                     stack_head:=stack_head^.next_ptr;
  321.                     DISPOSE(stack_ptr);
  322.                     delta_index_1:=delta_index_1+1
  323.                   END
  324.               UNTIL ((passage_found) OR (stack_head = NIL));
  325.               IF passage_found THEN
  326.                 BEGIN
  327.                   NEW(stack_ptr);
  328.                   stack_ptr^.next_ptr:=stack_head;
  329.                   stack_head:=stack_ptr;
  330.                   stack_head^.index_1:=delta_index_1;
  331.                   stack_head^.index_2:=delta_index_2;
  332.                   page[y_next,x_next]:=' ';
  333.                   IF x = x_next THEN
  334.                     BEGIN
  335.                       y_wall_1:=(y+y_next) DIV 2;
  336.                       page[y_wall_1,x_next]:=' '
  337.                     END
  338.                   ELSE
  339.                     BEGIN
  340.                       x_wall_1:=(x+x_next) DIV 2;
  341.                       page[y_next,x_wall_1]:=' '
  342.                     END;
  343.                   x:=x_next;
  344.                   y:=y_next
  345.                 END
  346.             UNTIL (stack_head = NIL);
  347.             page[0,1]:=' ';
  348.             page[y_max,x_max-1]:=' ';
  349.             WRITE(LST,CHR(27),'A',CHR(8),chr(27),'2');
  350.             power_of_two:=128;
  351.             FOR column:=0 TO 479 DO
  352.               print_line[column]:=0;
  353.             row_mod_6:=0;
  354.             y_out:=0;
  355.             WHILE (y_out <= y_max) DO
  356.               BEGIN
  357.                 column:=0;
  358.                 column_mod_5:=0;
  359.                 x_out:=0;
  360.                 WHILE (x_out <= x_max) DO
  361.                   BEGIN
  362.                     IF page[y_out,x_out] = 'W' THEN
  363.                       print_line[column]:=print_line[column]+power_of_two;
  364.                     IF column_mod_5 = 0 THEN
  365.                       x_out:=x_out+1;
  366.                     column:=column+1;
  367.                     column_mod_5:=column_mod_5+1;
  368.                     IF column_mod_5 >= 5 THEN
  369.                       BEGIN
  370.                         column_mod_5:=0;
  371.                         x_out:=x_out+1
  372.                       END
  373.                   END;
  374.                 power_of_two:=power_of_two DIV 2;
  375.                 IF power_of_two = 0 THEN
  376.                   BEGIN
  377.                     WRITE(LST,CHR(27)); WRITE(LST,'K');
  378.                     WRITE(LST,CHR(224)); WRITE(LST,CHR(1));
  379.                     power_of_two:=128;
  380.                     FOR column:=0 TO 479 DO
  381.                       BEGIN
  382.                         WRITE(LST,CHR(print_line[column]));
  383.                         print_line[column]:=0
  384.                       END
  385.                   END;
  386.                 IF row_mod_6 = 0 THEN
  387.                   y_out:=y_out+1;
  388.                 row_mod_6:=row_mod_6+1;
  389.                 IF row_mod_6 >= 6 THEN
  390.                   BEGIN
  391.                     row_mod_6:=0;
  392.                     y_out:=y_out+1
  393.                   END
  394.               END;
  395.             WRITE(LST,CHR(27)); WRITE(LST,'K');
  396.             WRITE(LST,CHR(224)); WRITE(LST,CHR(1));
  397.             FOR column:=0 TO 479 DO
  398.               WRITE(LST,CHR(print_line[column]));
  399.             WRITE(LST,CHR(27),'A',CHR(12),CHR(27),'2');
  400.             WRITELN(LST,' ');
  401.             WRITE(LST,'Seed:  '); WRITELN(LST,SEED);
  402.             WRITE(LST,CHR(12))
  403.           END;
  404.         WRITE(LST,CHR(12))
  405.       END
  406.   END.
  407.